home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
mouse.arc
/
MACU.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-08-05
|
19KB
|
736 lines
unit macu;
Interface
Uses Graph,mousu;
type
subtype = Array [1..10,1..10] of Record
Title:string;
end;
gwindowtype = Array [1..100] of Record
Xspot,
Yspot,
Xend,
Yend,kind:Integer;
Title:string;
end;
Menutype = Array [1..10] of Record
Title:String;
Legth:integer;
end;
ordertype = array [1..100] of integer;
Var
gray50:fillpatterntype;
gwindow:gwindowtype;
Menu:Menutype;
submenu:subtype;
order:ordertype;
Number,XX,
Legth,YY,
X,Y,kind,xx2,
amountofmenus,
amountofwindows,
color,
zz,
topx,topy,
botx,boty,
omousex,
omousey,
mmousex,
mmousey,
movex,
movey,lcv,lcv2,
current:integer;
Title:string;
Resized,
Moved:boolean;
Procedure StartUpScreen;
Procedure SetUpMouseToCurrentWindow;
Procedure MakeMenu(Number:integer;Title:string);
Procedure MakeSubMenu(number,x:integer;title:string);
Procedure CheckMenu(number:integer;var chosen:integer);
Procedure ShowIcon(X,Y,number:Integer);
Procedure SpecialIcon(Xx,Yy:integer;title:string);
Function CurrentDrawingWindow:integer;
Procedure SetCurrentDrawingWindow(number:integer);
Function GetMaxWindowX:Integer;
Function GetMaxWindowY:Integer;
Function GetMinWindowX:Integer;
Function GetMinWindowY:Integer;
Function FreeWindow:Integer;
Procedure ShowAllWindows;
Procedure CloseWindow(number:integer);
Procedure MakeWindow(number,X,Y,xx,yy:integer;title:string;kind:integer);
Procedure MoveWindow(number,X,Y,xx,yy:integer);
Procedure ShowWindow(number:integer);
Procedure Checkwindow(number:integer);
Procedure CheckAllWindows;
Implementation
Procedure StartUpScreen;
Begin
hidemousecursor;
setviewport(0,0,getmaxx,getmaxy,clipoff);
Setfillpattern(gray50,color);
Bar(0,10,GetMaxX,GetMaxY);
SetFillstyle(1,15);
Bar(0,0,GetMaxX,9);
SetTextStyle(smallfont,horizdir,4);
setcolor(0);
XX:=0;
for lcv:=1 to amountofmenus do
begin
outtextxy(xx,-1,menu[lcv].title);
xx:=xx+menu[lcv].Legth;
end;
showmousecursor;
end;
Procedure SetUpMouseToCurrentWindow;
var
viewport:viewporttype;
begin
getbuttonstatus;
getviewsettings(viewport);
with viewport do
begin
mousex:=mousex-x1;
mousey:=mousey-y1;
end;
end;
Procedure Puttop(number:integer);
var
noo:integer;
begin
noo:=amountofwindows;
For lcv:=1 to amountofwindows do
if order[lcv]=number then noo:=lcv;
for lcv:=noo downto 1 do
order[lcv]:=order[lcv-1];
order[1]:=number;
end;
Procedure getridof(number:integer);
var
noo:integer;
begin
For lcv:=1 to amountofwindows do
if order[lcv]=number then noo:=lcv;
for lcv:=noo to amountofwindows do
begin
order[lcv]:=order[lcv+1];
end;
amountofwindows:=amountofwindows-1;
end;
Procedure ShowIcon(X,Y,number:Integer);
begin
if number=1 then
begin
rectangle(x,y,x+32,y+32);
line(x+27,y,x,y+27);
end;
if number=2 then
begin
outtextxy(x+5,y+5,'DATA');
end;
end;
Procedure SpecialIcon(Xx,Yy:integer;title:string);
var
co,txt3:integer;
txt2:char;
begin
assign(input,title);
reset(input);
for y:=1 to 32 do
begin
for x:=1 to 32 do
begin
read(input,txt2);
co:=0;
val(txt2,co,txt3);
if txt3=1 then
begin
if txt2='A' then co:=10;
if txt2='B' then co:=11;
if txt2='C' then co:=12;
if txt2='D' then co:=13;
if txt2='E' then co:=14;
if txt2='F' then co:=15;
end;
putpixel(x+xx,y+yy,co);
end;
readln(input,txt2);
end;
close(input);
end;
Function CurrentDrawingWindow:integer;
begin
currentdrawingwindow:=current;
end;
Procedure SetCurrentDrawingWindow(number:integer);
Begin
current:=number;
kind:=gwindow[number].kind;
if (kind=1) or (kind=2) or (kind=3) then
begin
setviewport( gwindow[number].xspot+10,gwindow[number].yspot+10,
gwindow[number].xend+10,gwindow[number].yend+10,clipon);
end;
if kind=5 then
begin
setviewport( gwindow[number].xspot,gwindow[number].yspot+10,
gwindow[number].xend,gwindow[number].yend,clipon);
end;
if kind=4 then
begin
setviewport( gwindow[number].xspot,gwindow[number].yspot,
gwindow[number].xend,gwindow[number].yend,clipon);
end;
end;
Function GetMaxWindowX:Integer;
Var
viewport:viewporttype;
Begin
getviewsettings(viewport);
with viewport do
begin
getmaxwindowx:=x2;
end;
end;
Function GetMaxWindowY:Integer;
Var
viewport:viewporttype;
Begin
getviewsettings(viewport);
with viewport do
begin
getmaxwindowy:=y2;
end;
end;
Function GetMinWindowX:Integer;
Var
viewport:viewporttype;
Begin
getviewsettings(viewport);
with viewport do
begin
getminwindowx:=x1;
end;
end;
Function GetMinWindowY:Integer;
Var
viewport:viewporttype;
Begin
getviewsettings(viewport);
with viewport do
begin
getminwindowy:=y1;
end;
end;
Function FreeWindow:integer;
begin
for lcv:=1 to 100 do
begin
if gwindow[lcv].title='' then
begin
freewindow:=lcv;
exit;
end;
end;
end;
Procedure ShowWindow(number:integer);
var
mx,lcv,ln:integer;
begin
ln:=-1;
setviewport(0,0,getmaxx,getmaxy,clipoff);
x:=gwindow[number].xspot;
y:=gwindow[number].yspot;
xx:=gwindow[number].xend;
yy:=gwindow[number].yend;
kind:=gwindow[number].kind;
setfillstyle(1,15);
bar(x,y,xx,yy);
setcolor(0);
rectangle(x,y,xx,yy);
if (kind<>4) and (kind<>5) then rectangle(x+10,y+10,xx-10,yy-10);
if (kind=1) or (kind=2) then rectangle(x+2,y+2,x+8,y+8);
if (kind=1) or (kind=3) then rectangle(xx-2,yy-2,xx-8,yy-8);
if (kind=5) then line(x,y+10,xx,y+10);
if kind<>4 then
begin
repeat
ln:=ln+1;
mx:=gwindow[number].xend-gwindow[number].xspot;
mx:=mx div 2;
mx:=mx-((length(gwindow[number].title)-ln)*6);
mx:=mx+gwindow[number].xspot;
until mx>gwindow[number].xspot+10;
moveto(mx,gwindow[number].yspot-1);
for lcv:=1 to length(gwindow[number].title)-ln do
begin
outtext(gwindow[number].title[lcv]);
end;
setviewport(x,y,xx,yy,clipon);
if (order[1]=number) and (gwindow[number].title<>'') then
begin
for lcv:=1 to 4 do
begin
if (kind=1) or (kind=2) then line(10,lcv*2,mx-2-topx,lcv*2);
if (kind=3) or (kind=5) then line(0,lcv*2,mx-2-topx,lcv*2);
line((mx+((length(gwindow[number].title)-ln)*6))-topx,lcv*2,botx-topx,lcv*2);
end;
end;
end;
if (kind<>4) or (kind<>5) then setviewport(x+10,y+10,xx-10,yy-10,clipon);
if kind=5 then setviewport(x,y+10,xx,yy,clipon);
if kind=4 then setviewport(x,y,xx,yy,clipon);
end;
Procedure ShowAllWindows;
begin
hidemousecursor;
For lcv:=amountofwindows downto 1 do
begin
if gwindow[order[lcv]].title<>'' then showwindow(order[lcv]);
end;
showmousecursor;
end;
procedure CloseWindow(number:integer);
begin
hidemousecursor;
setfillpattern(gray50,color);
bar(topx,topy,botx,boty);
showmousecursor;
gwindow[number].xspot:=getmaxx+1;
gwindow[number].yspot:=getmaxy+1;
gwindow[number].xend:=getmaxx+1;
gwindow[number].yend:=getmaxy+1;
gwindow[number].title:='';
getridof(number);
end;
Procedure MakeWindow(number,X,Y,XX,YY:integer;title:string;kind:integer);
Begin
amountofwindows:=amountofwindows+1;
puttop(number);
gwindow[number].xspot:=x;
gwindow[number].yspot:=y;
gwindow[number].xend:=XX;
gwindow[number].yend:=yy;
gwindow[number].title:=title;
gwindow[number].kind:=kind;
end;
Procedure MoveWindow(number,X,Y,xx,yy:integer);
begin
puttop(number);
gwindow[number].xspot:=x;
gwindow[number].yspot:=y;
gwindow[number].xend:=XX;
gwindow[number].yend:=yy;
end;
Procedure MoveNew;
var
omx,mx,
omy,my:integer;
Begin
setviewport(0,0,getmaxx,getmaxy,clipoff);
setwritemode(1);
setcolor(15);
mx:=mousex+movex;
my:=mousey+movey;
omx:=mx;
omy:=my;
repeat
if (omx<>mx) or (omy<>my) then
begin
if mx<1 then
begin
mx:=omx;
hidemousecursor;
SetMouseCursorPos(omx-movex,mousey);
showmousecursor;
end;
if my<11 then
begin
my:=omy;
hidemousecursor;
SetMouseCursorPos(mousex,omy-movey);
showmousecursor;
end;
hidemousecursor;
rectangle(OMx,OMy,Omx+(botx-topx),Omy+(boty-topy));
rectangle(Mx,My,mx+(botx-topx),my+(boty-topy));
showmousecursor;
end;
omx:=mx;
omy:=my;
getbuttonstatus;
mx:=mousex+movex;
my:=mousey+movey;
until mkey<>left;
hidemousecursor;
rectangle(OMx,OMy,Omx+(botx-topx),Omy+(boty-topy));
showmousecursor;
setwritemode(0);
moved:=true;
end;
Procedure changebox;
var
omx,mx,
omy,my:integer;
Begin
setviewport(0,0,getmaxx,getmaxy,clipoff);
setwritemode(1);
setcolor(15);
mx:=mousex+movex;
my:=mousey+movey;
omx:=mx;
omy:=my;
repeat
if (omx<>mx) or (omy<>my) then
begin
hidemousecursor;
rectangle(topx,topy,mx+(botx-topx),my+(boty-topy));
rectangle(topx,topy,Omx+(botx-topx),Omy+(boty-topy));
showmousecursor;
end;
omx:=mx;
omy:=my;
getbuttonstatus;
mx:=mousex+movex;
my:=mousey+movey;
until mkey<>left;
hidemousecursor;
rectangle(topx,topy,Omx+(botx-topx),Omy+(boty-topy));
showmousecursor;
setwritemode(0);
resized:=true;
end;
Procedure Checkwindow(number:integer);
begin
if gwindow[number].title='' then exit;
topx:=gwindow[number].xspot;
topy:=gwindow[number].yspot;
botx:=gwindow[number].xend;
boty:=gwindow[number].yend;
kind:=gwindow[number].kind;
omousex:=mousex;
omousey:=mousey;
if (mkey=left) and ((mousex<topx+10) or (mousex>botx-10) or
(mousey<topy+10) or (mousey>boty-10)) then
begin
if (kind<>4) and (mousex<botx) and (mousex>topx+10) then
begin
if (mousey>topy) and (mousey<topy+10) then
begin
movex:=topx-mousex;
movey:=topy-mousey;
movenew;
mmousex:=mousex-omousex;
mmousey:=mousey-omousey;
hidemousecursor;
setfillpattern(gray50,color);
bar(topx,topy,botx,boty);
topx:=mmousex+topx;
topy:=mmousey+topy;
botx:=mmousex+botx;
boty:=mmousey+boty;
MoveWindow(number,topx,topy,botx,boty);
showmousecursor;
puttop(number);
end;
end;
if ((kind=1) or (kind=3)) and (mousex<botx) and (mousex>botx-10) and (mousey<boty) and (mousey>boty-10) then
begin
movex:=topx-mousex;
movey:=topy-mousey;
setminmaxhorzcurspos(topx+40,getmaxx);
setminmaxvertcurspos(topy+40,getmaxy);
changebox;
mmousex:=mousex-omousex;
mmousey:=mousey-omousey;
hidemousecursor;
setfillpattern(gray50,color);
bar(topx,topy,botx,boty);
botx:=mmousex+botx;
boty:=mmousey+boty;
MoveWindow(number,topx,topy,botx,boty);
setminmaxhorzcurspos(0,getmaxx);
setminmaxvertcurspos(0,getmaxy);
showmousecursor;
puttop(number);
end;
if ((kind=1) or (kind=2)) and (mousex>topx) and (mousex<topx+10) and (mousey>topy) and (mousey<topy+10) then
begin
hidemousecursor;
setfillpattern(gray50,color);
bar(topx,topy,botx,boty);
showmousecursor;
gwindow[number].xspot:=getmaxx+1;
gwindow[number].yspot:=getmaxy+1;
gwindow[number].xend:=getmaxx+1;
gwindow[number].yend:=getmaxy+1;
gwindow[number].title:='';
getridof(number);
end;
end;
end;
Procedure CheckAllWindows;
var
no,nwindow:integer;
Begin
moved:=false;
resized:=false;
if mkey=left then
begin
checkwindow(order[1]);
if amountofwindows>1 then
begin
for nwindow:=2 to amountofwindows do
begin
no:=0;
for lcv:=1 to nwindow-1 do
begin
if ((mousex<gwindow[order[lcv]].xspot) or (mousex>gwindow[order[lcv]].xend)) or
((mousey<gwindow[order[lcv]].yspot) or (mousey>gwindow[order[lcv]].yend)) then
no:=no+1;
end;
if no=nwindow-1 then checkwindow(order[nwindow]);
end;
end;
if (moved) or (resized) then showallwindows;
current:=order[1];
end;
end;
Procedure MakeMenu(Number:integer;Title:string);
Begin
Menu[number].title:=title;
menu[number].Legth:=length(title)*6;
amountofmenus:=amountofmenus+1;
end;
Procedure MakeSubMenu(number,x:integer;title:string);
begin
submenu[number,x].title:=title;
end;
Procedure CheckSubmenu(number,zz:integer;var chosen:integer);
var
yy:integer;
begin
if mkey=right then
begin
yy:=0;
for lcv:=1 to zz do
begin
if submenu[number,lcv].title<>'' then yy:=yy+10;
end;
if (mousex>xx) and (mousex<xx2) and (mousey>yy) and (mousey<yy+10) then
begin
hidemousecursor;
setfillstyle(1,0);
bar(xx,yy,xx2,yy+10);
setcolor(15);
outtextxy(xx,yy,submenu[number,lcv].title);
showmousecursor;
chosen:=zz;
repeat
getbuttonstatus;
until (mkey<>right) or (mousey<yy) or (mousey>yy+10);
hidemousecursor;
setfillstyle(1,15);
bar(xx,yy,xx2,yy+10);
setcolor(0);
outtextxy(xx,yy,submenu[number,lcv].title);
showmousecursor;
end;
end;
end;
procedure showmenu(number:integer;var chosen:integer);
var
yy:integer;
title:string;
begin
setfillstyle(1,0);
bar(xx,0,xx+menu[number].legth,10);
setcolor(15);
outtextxy(xx,-1,menu[number].title);
setfillstyle(1,15);
yy:=10;
xx2:=0;
for lcv:=1 to 10 do
begin
title:=submenu[number,lcv].title;
if title<>'' then yy:=yy+10;
if (title<>'') and (length(title)>xx2) then xx2:=length(title);
end;
xx2:=xx2*6+xx;
bar(xx,10,xx2,yy);
setcolor(7);
rectangle(xx-1,10,xx2+1,yy+1);
setcolor(0);
yy:=10;
for lcv:=1 to 10 do
begin
if submenu[number,lcv].title<>'' then
begin
outtextxy(xx,yy,submenu[number,lcv].title);
yy:=yy+10;
end;
end;
showmousecursor;
repeat
chosen:=0;
for lcv:=1 to 10 do
begin
if submenu[number,lcv].title<>'' then checksubmenu(number,lcv,chosen);
end;
getbuttonstatus;
until (mkey<>right) or (((mousex<xx) or (mousex>xx+menu[number].legth)) and (mousey<10));
hidemousecursor;
setfillstyle(1,15);
bar(xx,0,xx+menu[number].legth,10);
setcolor(0);
outtextxy(xx,-1,menu[number].title);
setfillpattern(gray50,color);
bar(xx-1,10,xx2+1,yy+1);
showmousecursor;
end;
Procedure CheckMenu(number:integer;var chosen:integer);
begin
setviewport(0,0,getmaxx,getmaxy,clipoff);
xx:=0;
if mkey=right then
begin
if (mousey>0) and (mousey<10) then
begin
for lcv:=1 to number-1 do
begin
xx:=xx+menu[lcv].legth;
end;
if (mousex>xx) and (mousex<xx+menu[lcv].legth) then
begin
hidemousecursor;
showmenu(number,chosen);
showallwindows;
end;
end;
end;
end;
Begin
for lcv:=1 to 4 do
begin
gray50[lcv*2-1]:=($AA);
gray50[lcv*2]:=($55);
end;
for lcv:=1 to 100 do
begin
gwindow[lcv].xspot:=getmaxx+1;
gwindow[lcv].yspot:=getmaxy+1;
gwindow[lcv].xend:=getmaxx+1;
gwindow[lcv].yend:=getmaxy+1;
gwindow[lcv].title:='';
order[lcv]:=0;
end;
for lcv:=1 to 10 do
begin
for lcv2:=1 to 10 do
begin
submenu[lcv,lcv2].Title:='';
end;
end;
for lcv:=1 to 10 do
begin
menu[lcv].title:='';
menu[lcv].legth:=0;
end;
amountofmenus:=0;
amountofwindows:=0;
color:=7;
End.